(PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")
                     T)
         (LISPXPRIN1 (QUOTE "14-MAR-73 20:14:45")
                     T)
         (LISPXTERPRI T))
  (LISPXPRINT (QUOTE URINEVARS)
              T)
  (RPAQQ URINEVARS
         ((FNS COMPUTEU STRIPH CLCONTAINS SUPERATOMSIZES SUPERATOMSIZE 
               SUPERATOMCOMPS COMPOF MAKESATLIST URINESAT URINESAT1 
               CLSUM SUPERATOMUS EXPLAIN URINERINGS QREAD START URINE 
               MARKACTIVESITES)
          (VARS COMP1 COMP2 COMP3 COMP4)
          (RECORD SATLIST)
          (EDITMACRO QW)
          (PROP EXPLAINATION URINERINGS)))
(DEFINEQ

(COMPUTEU
  [LAMBDA (CL)
    (QUOTIENT (COMPUTEFV 0 CL)
              2])

(STRIPH
  [LAMBDA (CL)
    (FOR NEW X IN CL WHEN (NOT (EQ (QUOTE H)
                                   (CAR X)))
                          XLIST X])

(CLCONTAINS
  [LAMBDA (CLSMALL CL)
    (PROG (FOR-VALUE Y LIST*X X)
          (SETQ FOR-VALUE T)
          (SETQ LIST*X CLSMALL)
      LOOP*1
          (COND
            ((NOT LIST*X)
              (GO RETURN)))
          (SETQ X (CAR LIST*X))
          (SETQ Y (CDR (ASSOC (CAR X)
                              CL)))
          (COND
            ([NOT (SETQ FOR-VALUE (AND Y (NOT (LESSP Y (CDR X]
              (RETURN FOR-VALUE)))
      NEXT*1
      NEXT*Y
      NEXT*X
          (SETQ LIST*X (CDR LIST*X))
          (GO LOOP*1)
      RETURN
          (RETURN FOR-VALUE])

(SUPERATOMSIZES
  [LAMBDA NIL
    (GSET (QUOTE SUPERATOMSIZES)
          (PROG (FOR-VALUE LIST*S S)
                (SETQ LIST*S SUPERATOMLIST)
            LOOP*1
                (COND
                  ((NOT LIST*S)
                    (GO RETURN)))
                (SETQ S (CAR LIST*S))
                (SETQ FOR-VALUE (CONS (SUPERATOMSIZE S)
                                      FOR-VALUE))
            NEXT*1
            NEXT*S
                (SETQ LIST*S (CDR LIST*S))
                (GO LOOP*1)
            RETURN
                (RETURN FOR-VALUE)))
    (GSET (QUOTE SUPERATOMSIZES)
          (INTERSECTION SUPERATOMSIZES SUPERATOMSIZES])

(SUPERATOMSIZE
  [LAMBDA (S)
    (FOR NEW C IN (COND
                    ((STRUCTURE? S)
                      (CTABLE S))
                    (T S))
                  PLUS 1])

(SUPERATOMCOMPS
  [LAMBDA NIL
    (GSET (QUOTE SUPERATOMCOMPS)
          (MAPCAR (GROUPBY (FUNCTION SUPERATOMSIZE)
                           SUPERATOMLIST)
                  (FUNCTION (LAMBDA (X)
                      (CONS (CAR X)
                            (MAPCAR (CDR X)
                                    (FUNCTION COMPOF])

(COMPOF
  [LAMBDA (SUP)
    (CLCREATE (FOR NEW N IN (COND
                              ((STRUCTURE? SUP)
                                (CTABLE SUP))
                              (T SUP))
                            XLIST
                            (ATOMTYPE (MARKERS N])

(MAKESATLIST
  [LAMBDA NIL
    [IF (NOT SUPERATOMLIST)
        THEN (LOAD (QUOTE URINESUPERATOMS))
             [PRINT (CONCAT "LIST OF ALREADY AVAILABLE SUPERATOMS --"
                            (SETQ SUPERATOMLIST
                              (CDR (SASSOC (QUOTE VARS)
                                           URINESUPERATOMSVARS]
             (SETQ SUPERATOMLIST (FOR X IN SUPERATOMLIST
                                    WHEN (EQ (RP X)
                                             (QUOTE YES))
                                         XLIST
                                         (EVAL X]
    (GSET (QUOTE FINDSUPERATOMLIST)
          (FOR NEW X
             IN SUPERATOMLIST XLIST
                (SATLIST SAU =(COMPUTEU (CONS (CONS (QUOTE H)
                                                    (VALENCE X))
                                              (COMPOF X)))
                         SACL =(COMPOF X)
                         SATOM = X)))
    (QUOTE FINDSUPERATOMLIST-IS-NOW-SET])

(URINESAT
  [LAMBDA (CL U)
    (PROG (A B C)
          (SETQ A (MAPCAR (URINESAT1 CL U SUPERATOMUS)
                          (FUNCTION CLCREATE)))
          [SETQ A
            (FOR NEW PART
               IN A XLIST
                  (MAPCAR PART
                          (FUNCTION (LAMBDA (X)
                              (CONS (FOR NEW ZZ IN FINDSUPERATOMLIST
                                       WHEN (EQP (CAR X)
                                                 (SAU ZZ))
                                            XLIST
                                            (CONS (CAR X)
                                                  (SACL ZZ)))
                                    (CDR X]
          (RETURN (FOR NEW B IN A FOR NEW Z IN (GROUPRADS B)
                     WHEN (CLCONTAINS (SETQ C (CLSUM (CDRLIST Z)))
                                      CL)
                          XLIST
                          (CONS (CLCREATE Z)
                                (CLDIFF CL C])

(URINESAT1
  [LAMBDA (CL U L)
    (PROG (A B)
          (RETURN (COND
                    ((ZEROP U)
                      (LIST NIL))
                    (T (FOR L ON L AS NEW X IS (CAR L)
                          WHEN (AND (NOT (GREATERP X U))
                                    (SETQ A (URINESAT1 CL (DIFFERENCE
                                                         U X)
                                                       L)))
                               APPEND
                               (FOR NEW Z IN A XLIST (CONS X Z])

(CLSUM
  [LAMBDA (LL)
    (FOR NEW X IN LL FOR NEW L IN X FOR NEW I :=(1 (CDR L))
                                        CLINSERT
                                        (CAR L])

(SUPERATOMUS
  [LAMBDA NIL
    (PROG (A)
          (GSET (QUOTE SUPERATOMUS)
                (INTERSECTION (SETQ A (FOR NEW Z
                                         IN FINDSUPERATOMLIST XLIST
                                            (SAU Z)))
                              A])

(EXPLAIN
  [LAMBDA (FORM)
    (COND
      [(STRUCLIST? FORM)
        (CONS (QUOTE LIST)
              (CONS (QUOTE WITH)
                    (COND
                      ((NOT EXPLAINALL)
                        (FINDSUBLISTS FORM))
                      (T (FOR NEW X IN (CDDR FORM)
                                       AS NEW I :=(1 9999)
                                       APPEND
                                       (LIST "

#" I (EXPLAIN X]
      [(STRUCFORM? FORM)
        (COND
          ((GETP (CADR FORM)
                 (QUOTE EXPLAINATION))
            (APPLY (GETP (CADR FORM)
                         (QUOTE EXPLAINATION))
                   (CDDR FORM)))
          (T (HELP "NO EXPLAINATION AVAILABLE" (CADR FORM]
      [(STRUCTURE? FORM)
        (COND
          [(EQ (LASTNODE# FORM)
               2)
            (LIST [ATOMTYPE (MARKERS (CAR (CTABLE FORM]
                  (BONDING (FOR NEW X
                              IN (NBRS (CAR (CTABLE FORM)))
                              WHEN (NOT (EQ X (QUOTE FV)))
                                   IPLUS 1))
                  (ATOMTYPE (MARKERS (CADR (CTABLE FORM]
          (T (≠QUOTE (STRUCTURE # ≠
                                 (CAAR (SETQ DRAWLIST
                                         (CONS (CONS (SETQ STRUCNUM
                                                       (ADD1 STRUCNUM))
                                                     FORM)
                                               DRAWLIST)))
                                 DRAWN BELOW]
      (T (≠QUOTE (STRUCTURE # ≠
                             (CAAR (SETQ DRAWLIST
                                     (CONS (CONS (SETQ STRUCNUM
                                                   (ADD1 STRUCNUM))
                                                 FORM)
                                           DRAWLIST)))
                             DRAWN BELOW])

(URINERINGS
  [LAMBDA (U CL)
    (FOR NEW X IN FINDSUPERATOMLIST
       WHEN (AND (EQP U (SAU X))
                 (EQUAL CL (SACL X)))
            XLIST
            (SATOM X])

(QREAD
  [LAMBDA (FILE)
    (PROGN (INFILE FILE)
           (PROG1 (READ FILE T)
                  (CLOSEF FILE])

(START
  [LAMBDA (NUM)
    (PROG (CL U)
          (IF (NOT FINDSUPERATOMLIST)
              THEN (UNCOLLECT)
                   (MAKESATLIST)
                   (RECOLLECT))
          (FOR NUM :=(1 (COND
                          (NUM NUM)
                          (T 1)))
             DO (SETQ CL (RP "CL"))
                (SETQ U (RP "U"))
                [COND
                  ((ATOM CL)
                    (SETQ CL (EVAL CL]
                (TIME (EDITE (CAR (MOLECULES CL U)))
                      1 0])

(URINE
  [LAMBDA NIL
    (PROG NIL
          (MAKESATLIST)
          (SUPERATOMCOMPS)
          (SUPERATOMSIZES)
          (SUPERATOMUS)
          [ADVISE (QUOTE SUPERATOMPARTITIONS)
                  (QUOTE BEFORE)
                  (QUOTE (RETURN (URINESAT CL U]
          [ADVISE (QUOTE MOLECULES)
                  (QUOTE BEFORE)
                  (QUOTE (COND
                           ((NOT U)
                             (SETQ U (COMPUTEU CL))
                             (SETQ CL (STRIPH CL]
          [ADVISE (QUOTE RINGS)
                  (QUOTE BEFORE)
                  (QUOTE (RETURN (URINERINGS U CL]
          (TURNOFF (QUOTE URINERINGS))
          (TURNOFF (QUOTE MOLECULES))
          (PUT (QUOTE URINERINGS)
               (QUOTE EXPLAINATION)
               (QUOTE URINERINGS])

(MARKACTIVESITES
  [LAMBDA (STRUC NODES)
    (STRUCTURE
       FROM STRUC CTABLE =(MAPCAR (CTABLE STRUC)
                                  (F/L (X)
                                       (COND
                                         ((MEMBER (NODENUM X)
                                                  NODES)
                                           X)
                                         (T (REMOVE ' FV X])
)
  (RPAQQ COMP1 ((C . 11)
          (H . 12)
          (N . 2)
          (O . 2)))
  (RPAQQ COMP2 ((C . 11)
          (H . 12)
          (N . 2)
          (O . 3)))
  (RPAQQ COMP3 ((C . 9)
          (H . 11)
          (N . 1)
          (O . 2)))
  (RPAQQ COMP4 ((C . 9)
          (H . 11)
          (N . 1)
          (O . 3)))
(DEFLIST(QUOTE(
  (SATLIST (SAU SACL SATOM))
))(QUOTE RECORD))

  (RECORD (QUOTE SATLIST))
(DEFLIST(QUOTE(
  [QW (QW NIL
          (IF (STRUCFORM? (##))
              ((BIND (E (SETQ #1 (GETFILENAM (QUOTE OUTPUT)))
                        T)
                     (E (OUTFILE #1))
                     (E (PRINT (LIST (##))
                               #1))
                     (E (CLOSEF #1))
                     (S #2)
                     UP MARK ↑
                     (E (DSUBST (≠QUOTE (STRUCFORM QREAD ≠ #1))
                                #2
                                (##))
                        T)
                     ←← 1]
))(QUOTE EDITMACRO))

  [EDITE (GETP (QUOTE QW)
               (QUOTE EDITMACRO))
         (QUOTE ((COMS (##]
(DEFLIST(QUOTE(
  (URINERINGS NIL)
))(QUOTE EXPLAINATION))

STOP